home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1996 June / EnigmA AMIGA RUN 08 (1996)(G.R. Edizioni)(IT)[!][issue 1996-06][EARSAN CD VII].iso / earcd / amos / jwindows.lha / Font.asc < prev    next >
Text File  |  1996-04-25  |  5KB  |  172 lines
  1. 'Note: 
  2. '   You may have trouble running this program from the editor. If so,
  3. 'change the Path$ variable in INITIALISE to point to the directory this
  4. 'example is in. This isn't a problem when compiled.
  5.  
  6. '************************************************************************* 
  7. '* 
  8. '*    Font Tester
  9. '* 
  10. '************************************************************************* 
  11.  
  12. '   Another simple little program - this lets the user select a font, then 
  13. ' type stuff with it on a little demo window. Totally pointless, but fun.
  14. '   As usual, the startup code, window and menus were doen in GadToolsBox, 
  15. ' with the last two procedures (for actually handling input) added by me.
  16. '
  17. '   This program really demonstrates simple menu handling. 
  18.  
  19. '** These are from GadToolsBox 
  20. Global _SCRAPTAGS,SCRAPTAGS,_PORTLIST,_MESSLIST
  21. Global PATH$,OSVER
  22. Global FHEIGHT,FWIDTH,MBAR,OX,OY,SW,SH
  23. Dim _FONTGADS(0)
  24. Global _FONTGADS()
  25. Global _FONTMENU,_FONTMENADD
  26. Global _FONTWIND
  27.  
  28. '** These are mine 
  29. 'FX,FY - the present drawing position
  30. 'MYASL - the asl font requester FXEDWIDTH - only used fixed width fonts? 
  31. Global FX,FY
  32. Global MYASL,FXEDWIDTH
  33.  
  34. On Error Proc _CLEANUP
  35. _INITIALIZE
  36. _GUIDATA
  37. _SETUPALL
  38. _SETPORTS
  39.  
  40. '** Set up the font requester with a few appropriate tags
  41.  
  42. J Tag _SCRAPTAGS,1,Equ("ASLFO_TitleText"),J Make String("Select a font")
  43. J Tag Equ("ASLFO_SleepWindow"),True
  44. J Tag Equ("ASLFO_Window"),_FONTWIND
  45. J Tag 0,0
  46. MYASL=J Create Asl Requester(Equ("ASL_FontRequest"),_SCRAPTAGS)
  47.  
  48. Do 
  49.    K=J Wait Message
  50.    While K
  51.       C=J Tag Data(_MESSLIST,1)
  52.       If C=Equ("IDCMP_CLOSEWINDOW")
  53.          _CLEANUP
  54.       Else If C=Equ("IDCMP_REFRESHWINDOW")
  55.          _DOREFRESH
  56.       Else 
  57.          _HANDLEFONTWIND[C]
  58.       End If 
  59.       K=J Next Message
  60.    Wend 
  61. Loop 
  62.  
  63. '** normal GadToolsBox generated code
  64.  
  65. Procedure _INITIALIZE
  66. Procedure _SETUPALL
  67. Procedure _GUIDATA
  68. Procedure _MAKEFONTGADS
  69. Procedure _MAKEFONTWIND[SC]
  70. Procedure _DOREFRESH
  71. Procedure _SETPORTS
  72. Procedure _FREEWIND[W,G,M,A,C]
  73. Procedure _CLEANUP
  74.  
  75. '** My procedures for handling everything
  76.  
  77. Procedure _HANDLEFONTWIND[C]
  78.    On Error Proc _CLEANUP
  79.    
  80.    '** First determine what the user has done.
  81.    ' On clicking a the LMB on the window, we change the drawing position
  82.    ' FX, FY 
  83.    ' If a key is pressed, write the key as text to the window 
  84.    ' If a menu item is selected, call the seperate menu handler 
  85.    
  86.    If C=Equ("IDCMP_MOUSEBUTTONS")
  87.       'The two tags here contain mouse coordinates 
  88.       FX=J Tag Data(_MESSLIST,5)-J X Offset
  89.       FY=J Tag Data(_MESSLIST,6)-J Y Offset
  90.       
  91.    Else If C=Equ("IDCMP_VANILLAKEY")
  92.       'write the character to the screen, then increment x position
  93.       If J Tag Data(_MESSLIST,2)>31
  94.          Text FX,FY+J Text Height,Chr$(J Tag Data(_MESSLIST,2))
  95.          FX=FX+Text Length(Chr$(J Tag Data(_MESSLIST,2)))
  96.       End If 
  97.       
  98.    Else If C=Equ("IDCMP_MENUPICK")
  99.       'obtain the menu definition
  100.       A=J Tag Data(_MESSLIST,2)
  101.       M=J Read Menu(A)
  102.       I=J Read Item(A)
  103.       S=J Read Subitem(A)
  104.       _HANDLEFONTMENU[M,I,S]
  105.       
  106.    End If 
  107.    
  108. End Proc
  109. Procedure _HANDLEFONTMENU[M,I,S]
  110.    On Error Proc _CLEANUP
  111.    
  112.    'project menu
  113.    If M=0
  114.       
  115.       'new font
  116.       If I=0
  117.          'call the font requester, if the user selects a valid font 
  118.          'change to it. 
  119.          J Tag _SCRAPTAGS,1,Equ("ASLFO_FixedWidthOnly"),FXEDWIDTH
  120.          J Tag 0,0
  121.          If J Font Request(MYASL,_SCRAPTAGS)
  122.             J Set Font 
  123.          End If 
  124.          
  125.          'quit
  126.       Else If I=2
  127.          _CLEANUP
  128.       End If 
  129.       
  130.       'font menu 
  131.    Else If M=1
  132.       
  133.       'one of the writing style flags  
  134.       If I<3
  135.          'first, read state of all the writing style items
  136.          J Tag _SCRAPTAGS,1,$80000011,J Menu Item(1,0,-1)
  137.          J Tag $80000011,J Menu Item(1,1,-1)
  138.          J Tag $80000011,J Menu Item(1,2,-1)
  139.          J Tag 0,0
  140.          J Get Menu Data _FONTMENU,_FONTWIND,_SCRAPTAGS
  141.          'This expression takes the three seperate results of J Get Menu Data 
  142.          'and converts them into a single binary number suitable for Gr Writing 
  143.          'Note the use of the Sgn command as J Get Menu Data will return random 
  144.          'positive numbers, not always 1. 
  145.          Gr Writing Sgn(J Tag Data(_SCRAPTAGS,1))+2*Sgn(J Tag Data(_SCRAPTAGS,2))+4*Sgn(J Tag Data(_SCRAPTAGS,3))
  146.          
  147.          'fixed width only
  148.       Else If I=4
  149.          'flip state of the fixed width flag
  150.          Add FXEDWIDTH,1,0 To 1
  151.       End If 
  152.       
  153.       'style menu
  154.    Else If M=2
  155.       
  156.       'read all style flags  
  157.       J Tag _SCRAPTAGS,1,$80000011,J Menu Item(2,2,-1)
  158.       J Tag $80000011,J Menu Item(2,3,-1)
  159.       J Tag $80000011,J Menu Item(2,4,-1)
  160.       J Tag 0,0
  161.       J Get Menu Data _FONTMENU,_FONTWIND,_SCRAPTAGS
  162.       'this unpleasant looking expression takes the states of the bold,  
  163.       'italic and underline menu items, and combines them into one number
  164.       Set Text Sgn(J Tag Data(_SCRAPTAGS,3))+2*Sgn(J Tag Data(_SCRAPTAGS,1))+4*Sgn(J Tag Data(_SCRAPTAGS,2))
  165.       
  166.       'display menu  
  167.    Else If M=3
  168.       J Cls 0
  169.    End If 
  170.    
  171. End Proc
  172.